home *** CD-ROM | disk | FTP | other *** search
/ Power CD / Power CD ATARI-Rechner Lieben.iso / ALLERLEI / GOBJ_112 / SOURCE / BEISPIEL / BEISPL05.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-03-03  |  9.4 KB  |  374 lines
  1. program Beispiel; {$X+} { Beispiel Nr.5 }
  2.  
  3. uses
  4.  
  5.     Gem,OTypes,OProcs,OWindows,ODialogs;
  6.  
  7. const
  8.  
  9.     {$I beispiel.i}
  10.  
  11. type
  12.  
  13.     TMyApplication = object(TApplication)
  14.         procedure InitInstance; virtual;
  15.         procedure InitMainWindow; virtual;
  16.     end;
  17.  
  18.     PBeispielWindow = ^TBeispielWindow;
  19.     TBeispielWindow = object(TWindow)
  20.         Veraendert: boolean;
  21.         Dicke,
  22.         Farbe,
  23.         Art       : integer;
  24.         Pfad,
  25.         Datei     : string;
  26.         constructor Init(AParent: PWindow; ATitle: string);
  27.         function CanClose: boolean; virtual;
  28.         procedure WMButton(mX,mY,BStat,KStat,Clicks: integer); virtual;
  29.         { neue Methoden: }
  30.         procedure SetAttr(Width,Color,Style: integer); virtual;
  31.         procedure CreateTitle; virtual;
  32.     end;
  33.  
  34.     PAttrDialog = ^TAttrDialog;
  35.     TAttrDialog = object(TDialog)
  36.         function OK: boolean; virtual;
  37.         function Help: boolean; virtual;
  38.     end;
  39.  
  40.     PLineData = ^TLineData;
  41.     TLineData = record
  42.         Farben: array [0..7] of integer;
  43.         Stile : array [1..6] of integer;
  44.         Breite: string[5]
  45.     end;
  46.  
  47.     PAbout  = ^TAbout;
  48.     TAbout  = object(TKeyMenu)
  49.         procedure Work; virtual;
  50.     end;
  51.  
  52.     PNew    = ^TNew;
  53.     TNew    = object(TKeyMenu)
  54.         procedure Work; virtual;
  55.     end;
  56.  
  57.     POpen   = ^TOpen;
  58.     TOpen   = object(TKeyMenu)
  59.         procedure Work; virtual;
  60.     end;
  61.  
  62.     PSave   = ^TSave;
  63.     TSave   = object(TKeyMenu)
  64.         procedure Work; virtual;
  65.     end;
  66.  
  67.     PSaveAs = ^TSaveAs;
  68.     TSaveAs = object(TKeyMenu)
  69.         procedure Work; virtual;
  70.     end;
  71.  
  72.     PInfo   = ^TInfo;
  73.     TInfo   = object(TKeyMenu)
  74.         procedure Work; virtual;
  75.     end;
  76.  
  77.     PAttrib = ^TAttrib;
  78.     TAttrib = object(TKeyMenu)
  79.         LineData: TLineData;
  80.         procedure Work; virtual;
  81.     end;
  82.  
  83. var
  84.  
  85.     MyApp: TMyApplication;
  86.  
  87.  
  88. procedure MyResource; external; {$L beispiel.o}
  89.  
  90.  
  91. procedure TMyApplication.InitInstance;
  92.  
  93.     begin
  94.         InitResource(@MyResource,nil);
  95.         LoadMenu(BSPMENU);
  96.         new(PAbout,Init(@self,K_CTRL,Ctrl_A,MABOUT,MTITLE1));
  97.         new(PNew,Init(@self,K_CTRL,Ctrl_N,MNEW,MTITLE2));
  98.         new(POpen,Init(@self,K_CTRL,Ctrl_O,MOPEN,MTITLE2));
  99.         new(PSave,Init(@self,K_CTRL,Ctrl_S,MSAVE,MTITLE2));
  100.         new(PSaveAs,Init(@self,K_CTRL,Ctrl_D,MSAVEAS,MTITLE2));
  101.         new(PInfo,Init(@self,K_CTRL,Ctrl_I,MINFO,MTITLE3));
  102.         new(PAttrib,Init(@self,K_CTRL,Ctrl_T,MATTR,MTITLE3));
  103.         inherited InitInstance;
  104.         SetQuit(MQUIT,MTITLE2)
  105.     end;
  106.  
  107.  
  108. procedure TMyApplication.InitMainWindow;
  109.  
  110.     begin
  111.         new(PBeispielWindow,Init(nil,'Beispiel  [unbenannt]'));
  112.         if (MainWindow=nil) or (ChkError<em_OK) then
  113.             Status:=em_InvalidMainWindow
  114.     end;
  115.  
  116.  
  117. constructor TBeispielWindow.Init(AParent: PWindow; ATitle: string);
  118.  
  119.     begin
  120.         if not(inherited Init(AParent,ATitle)) then fail;
  121.         Veraendert:=false;
  122.         SetAttr(3,Blue,LT_SOLID);
  123.         Datei:='';
  124.         Pfad:=''
  125.     end;
  126.  
  127.  
  128. function TBeispielWindow.CanClose: boolean;
  129.     var valid: boolean;
  130.  
  131.     begin
  132.         valid:=inherited CanClose;
  133.         if valid and Veraendert then
  134.             valid:=(Application^.Alert(@self,1,WAIT,
  135.                 ' Die Grafik wurde verändert!| Wollen Sie sie speichern?',
  136.               '&Ja|  &Nein  ')=2);
  137.         CanClose:=valid
  138.     end;
  139.  
  140.  
  141. procedure TBeispielWindow.WMButton(mX,mY,BStat,KStat,Clicks: integer);
  142.     var xalt,yalt,btn,dummy: integer;
  143.         pxyarray           : ptsin_ARRAY;
  144.  
  145.     begin
  146.         if bTst(BStat,1) then
  147.             if GetDC>=0 then
  148.                 begin
  149.                     wind_update(BEG_MCTRL);
  150.                     vsl_width(vdiHandle,Dicke);
  151.                     vsl_color(vdiHandle,Farbe);
  152.                     vsl_type(vdiHandle,Art);
  153.                     vsl_ends(vdiHandle,LE_ROUNDED,LE_ROUNDED);
  154.                     repeat
  155.                         xalt:=mX;
  156.                         yalt:=mY;
  157.                         repeat
  158.                             graf_mkstate(mX,mY,btn,dummy)
  159.                         until (mX<>xalt) or (mY<>yalt) or not(bTst(btn,1));
  160.                         pxyarray[0]:=xalt;
  161.                         pxyarray[1]:=yalt;
  162.                         pxyarray[2]:=mX;
  163.                         pxyarray[3]:=mY;
  164.                         v_pline(vdiHandle,2,pxyarray)
  165.                     until not(bTst(btn,1));
  166.                     wind_update(END_MCTRL);
  167.                     ReleaseDC;
  168.                     Veraendert:=true;
  169.                     CreateTitle
  170.                 end;
  171.         if bTst(BStat,2) then
  172.             begin
  173.                 ForceRedraw;
  174.                 Veraendert:=false;
  175.                 CreateTitle
  176.             end
  177.     end;
  178.  
  179.  
  180. procedure TBeispielWindow.SetAttr(Width,Color,Style: integer);
  181.     const farben: array [0..7] of string[7] =
  182.         ('weiß','schwarz','rot','grün','blau','türkis','gelb','violett');
  183.                 arten: array [1..6] of string[16] =
  184.         ('durchgehend','langer Strich','Punkte','Strich, Punkt',
  185.                                      'Strich','Strich, 2 Punkte');
  186.  
  187.     begin
  188.         Dicke:=Width;
  189.         Farbe:=Color;
  190.         Art:=Style;
  191.         SetSubTitle(' Dicke: '+ltoa(Dicke)+'  Farbe: '+farben[Farbe]+
  192.                                 '   Art: '+arten[Art])
  193.     end;
  194.  
  195.  
  196. procedure TBeispielWindow.CreateTitle;
  197.     var titel: string;
  198.  
  199.     begin
  200.         if length(Datei)=0 then titel:='[unbenannt]'
  201.         else
  202.             titel:=Pfad+Datei;
  203.         if Veraendert then titel:='*'+titel;
  204.         titel:='Beispiel  '+titel;
  205.         SetTitle(titel)
  206.     end;
  207.  
  208.  
  209. function TAttrDialog.OK: boolean;
  210.     var valid: boolean;
  211.         d,f,s: integer;
  212.         attrb: ARRAY_4;
  213.  
  214.     begin
  215.         valid:=inherited OK;
  216.         if valid then
  217.             begin
  218.                 with PLineData(TransferBuffer)^ do
  219.                     begin
  220.                         f:=0;
  221.                         while Farben[f]<>bf_Checked do inc(f);
  222.                         s:=1;
  223.                         while Stile[s]<>bf_Checked do inc(s);
  224.                         vsl_width(vdiHandle,atol(Breite))
  225.                     end;
  226.                 vql_attributes(vdiHandle,attrb);
  227.                 PBeispielWindow(Application^.MainWindow)^.SetAttr(attrb[3],f,s)
  228.             end;
  229.         OK:=valid
  230.     end;
  231.  
  232.  
  233. function TAttrDialog.Help: boolean;
  234.  
  235.     begin
  236.         Application^.Alert(@self,1,NO_ICON,'In dieser Dialogbox werden die|Attribute der Linien eingestellt.|Die neuen Werte gelten ab der|ersten Linie, die nach dem|Schließen der Box gezeichnet|wird.','   &OK   ');
  237.         Help:=false
  238.     end;
  239.  
  240.  
  241. procedure TAbout.Work;
  242.  
  243.     begin
  244.         if ADialog=nil then
  245.             begin
  246.                 new(ADialog,Init(nil,'Über Beispiel',BSPABOUT));
  247.                 if ADialog<>nil then
  248.                     begin
  249.                         new(PGroupBox,Init(ADialog,IGROUP,'ObjectGEM '+
  250.                                                                 'Beispielprogramm','"42"'));
  251.                         new(PButton,Init(ADialog,IOK,id_OK,true,'Mit diesem '+
  252.                                             'Button|kann die Infobox|verlassen werden.'))
  253.                     end
  254.             end;
  255.         if ADialog<>nil then ADialog^.MakeWindow
  256.     end;
  257.  
  258.  
  259. procedure TNew.Work;
  260.  
  261.     begin
  262.         with PBeispielWindow(Application^.MainWindow)^ do
  263.             begin
  264.                 ForceRedraw;
  265.                 Veraendert:=false;
  266.                 Pfad:='';
  267.                 Datei:='';
  268.                 CreateTitle
  269.             end
  270.     end;
  271.  
  272.  
  273. procedure TOpen.Work;
  274.  
  275.     begin
  276.         Application^.Alert(nil,1,NOTE,'Die Funktion ist noch|'+
  277.                                                     'nicht implementiert.',' &Schade ')
  278.     end;
  279.  
  280.  
  281. procedure TSave.Work;
  282.  
  283.     begin
  284.         Application^.Alert(nil,1,NOTE,'Die Funktion ist noch|'+
  285.                                                     'nicht implementiert.',' &Schade ')
  286.     end;
  287.  
  288.  
  289. procedure TSaveAs.Work;
  290.  
  291.     begin
  292.         Application^.Alert(nil,1,NOTE,'Die Funktion ist noch|'+
  293.                                                     'nicht implementiert.',' &Schade ')
  294.     end;
  295.  
  296.  
  297. procedure TInfo.Work;
  298.  
  299.     begin
  300.         Application^.Alert(nil,1,NOTE,'Die Funktion ist noch|'+
  301.                                                     'nicht implementiert.',' &Schade ')
  302.     end;
  303.  
  304.  
  305. procedure TAttrib.Work;
  306.     var q: integer;
  307.  
  308.     begin
  309.         if ADialog=nil then
  310.             begin
  311.                 ADialog:=new(PAttrDialog,Init(nil,'Attribute',BSPATTR));
  312.                 if ADialog<>nil then
  313.                     begin
  314.                         new(PGroupBox,Init(ADialog,ACGROUP,'Farbe',
  315.                                                         'Bestimmt die|Linienfarbe'));
  316.                         new(PGroupBox,Init(ADialog,ASGROUP,'Stil',
  317.                                                         'Bestimmt den|Linienstil'));
  318.                         new(PRadioButton,Init(ADialog,AWHITE,true,
  319.                                                         'Setzt Weiß als|neue Linienfarbe'));
  320.                         new(PRadioButton,Init(ADialog,ABLACK,true,
  321.                                                         'Setzt Schwarz als|neue Linienfarbe'));
  322.                         new(PRadioButton,Init(ADialog,ARED,true,
  323.                                                         'Setzt Rot als|neue Linienfarbe'));
  324.                         new(PRadioButton,Init(ADialog,AGREEN,true,
  325.                                                         'Setzt Grün als|neue Linienfarbe'));
  326.                         new(PRadioButton,Init(ADialog,ABLUE,true,
  327.                                                         'Setzt Blau als|neue Linienfarbe'));
  328.                         new(PRadioButton,Init(ADialog,ACYAN,true,
  329.                                                         'Setzt Türkis als|neue Linienfarbe'));
  330.                         new(PRadioButton,Init(ADialog,AYELLOW,true,
  331.                                                         'Setzt Gelb als|neue Linienfarbe'));
  332.                         new(PRadioButton,Init(ADialog,AMAGENTA,true,
  333.                                                         'Setzt Violett als|neue Linienfarbe'));
  334.                         new(PRadioButton,Init(ADialog,ASOLID,true,
  335.                                                         'Setzt LT_SOLID als|neuen Linienstil'));
  336.                         new(PRadioButton,Init(ADialog,ALONG,true,
  337.                                                         'Setzt LT_LONGDASH als|neuen Linienstil'));
  338.                         new(PRadioButton,Init(ADialog,ADOTS,true,
  339.                                                         'Setzt LT_DOTTED als|neuen Linienstil'));
  340.                         new(PRadioButton,Init(ADialog,ALINEDOT,true,
  341.                                                         'Setzt LT_DASHDOT als|neuen Linienstil'));
  342.                         new(PRadioButton,Init(ADialog,ALINE,true,
  343.                                                         'Setzt LT_DASHED als|neuen Linienstil'));
  344.                         new(PRadioButton,Init(ADialog,ALIN2DOT,true,
  345.                                                         'Setzt LT_DASHDOTDOT|als neuen Linienstil'));
  346.                         new(PEdit,Init(ADialog,AWIDTH,5,
  347.                                     'Gibt die Linien-|stärke an (1,3,..).|Immer UNgerade!'));
  348.                         new(PButton,Init(ADialog,ACANCEL,id_Cancel,true,
  349.                             'Bricht den Dialog ab,|ohne die neuen Werte|zu übernehmen'));
  350.                         new(PButton,Init(ADialog,AOK,id_OK,true,
  351.                                                     'Beendet den Dialog und|setzt die neuen Werte'));
  352.                         new(PButton,Init(ADialog,AHELP,id_Help,false,
  353.                             'Zeigt einen allgemeinen|Hilfstext über diesen|Dialog an.'));
  354.                         with PBeispielWindow(Application^.MainWindow)^ do
  355.                             with LineData do
  356.                                 begin
  357.                                     for q:=0 to 7 do Farben[q]:=bf_Unchecked;
  358.                                     for q:=1 to 6 do Stile[q]:=bf_Unchecked;
  359.                                     Farben[Farbe]:=bf_Checked;
  360.                                     Stile[Art]:=bf_Checked;
  361.                                     Breite:=ltoa(Dicke)
  362.                                 end;
  363.                         ADialog^.TransferBuffer:=@LineData
  364.                     end
  365.             end;
  366.         if ADialog<>nil then ADialog^.MakeWindow
  367.     end;
  368.  
  369.  
  370. begin
  371.     MyApp.Init('BSPL','Beispiel');
  372.     MyApp.Run;
  373.     MyApp.Done
  374. end.